{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit UIObjects;

interface

uses Classes, Forms, SysUtils, AHMTypes, XMLHelper;

const
  DEFAULT_OBJECT_NAME = 'default';

{$IFDEF DESIGNER}
  // Property categories for designer
  CAT_IDENTITY = 'Identity';
  EMPTY_UIOBJECT_NAME = '<<none>>';

  // Property names for designer tools
  DESIGNER_SIZE = 'DesignerSize';
  DESIGNER_POS = 'DesignerPos';
  DESIGNER_ROT = 'DesignerRot';

  // Property hints for designer
  HINT_PREFIX = 'This property ';
  HINT_NAME = 'defines a unique name for the object';
  HINT_DESCRIPTION = 'defines a description for the object';
  HINT_COMMENT = 'provides information for users of the theme designer';
  HINT_ANCESTOR = 'associates a parent object to derive default properties from';
{$ENDIF}

type
  TAHMUIObjectList = class;
  TAHMUIStateObjectList = class;

  TAHMUIObjectListSort = (lsNatural, lsAlpha, lsDependencies);
  TAHMUIObjectState = (osValid, osWarn, osError);
  TAHMUIStateType = (stCheckableControl, stControl, stMedia, stCustom);

  TAHMUIProperty = class
  private
    FDisplayName: String;
    FPropertyName: String;
    FCategory: String;
    FHintText: String;
  public
    property DisplayName: String read FDisplayName write FDisplayName;
    property PropertyName: String read FPropertyName write FPropertyName;
    property Category: String read FCategory write FCategory;
    property HintText: String read FHintText write FHintText;
  end;

  TAHMUIPropertyList = class
  private
    FList: TList;
  protected
    function GetCount: Integer;
    function GetProperty(Index: Integer): TAHMUIProperty;
  public
    constructor Create;
    destructor Destroy; override;
    property Count: Integer read GetCount;
    property Properties[Index: Integer]: TAHMUIProperty read GetProperty; default;
    procedure Add(DisplayName, PropertyName, Category, HintText: String);
    procedure Remove(PropertyName: String);
    procedure Clear;
  end;

  TAHMUIObject = class(TPersistent)
  private
    FName: String;
    FDescription: String;
    FComment: TAHMMemoString;
    FState: TAHMUIObjectState;
    FAncestor: TAHMUIObject;
    FModified: Boolean;
    FPreviewable: Boolean;
    FXMLDraft: String;
    FXMLTagName: String;
    FXMLIndent: Integer;
    FOwner: TAHMUIObjectList;
    FImageIndex: Integer;
    FType: TAHMUIObjectType;
    function GetIsBaseObject: Boolean;
  protected
    procedure SetAncestor(Ancestor: TAHMUIObject); virtual;
    function GetDesignerInfo: String; virtual;
    function GetDesignerPos: String; virtual;
    procedure SetDesignerPos(Position: String); virtual;
    function GetDesignerSize: String; virtual;
    procedure SetDesignerSize(Size: String); virtual;
    function GetDesignerRot: String; virtual;
    procedure SetDesignerRot(Rotation: String); virtual;
    function GetObjectToCompare: TAHMUIObject;
    property ObjectToCompare: TAHMUIObject read GetObjectToCompare;
    function TagBegin: String; virtual;
    function TagEnd: String;
    procedure ClearProperties; virtual;
    procedure DoModified;
  public
    constructor Create(const Name: String); virtual;
    property Modified: Boolean read FModified write FModified;
    property State: TAHMUIObjectState read FState write FState;
    property Owner: TAHMUIObjectList read FOwner write FOwner;
    property DesignerInfo: String read GetDesignerInfo;
    property IsBaseObject: Boolean read GetIsBaseObject;
    property IsPreviewable: Boolean read FPreviewable write FPreviewable;
    property XMLDraft: String read FXMLDraft write FXMLDraft;
    property XMLTagName: String read FXMLTagName write FXMLTagName;
    property XMLIndent: Integer read FXMLIndent write FXMLIndent;
    property ImageIndex: Integer read FImageIndex write FImageIndex;
    property ObjectType: TAHMUIObjectType read FType write FType;
    function DesignerAdjustPos(DX, DY: Integer): Boolean; virtual;
    function DesignerAdjustSize(DX, DY: Integer): Boolean; virtual;
    function DesignerAdjustRot(DX, DY, DZ: Single): Boolean; virtual;
    function PreviewKeyPress(KeyCode: Word; Shift: TShiftState): Boolean; virtual;
    function PreviewMouseDown(X, Y: Single): Boolean; virtual;
    function PreviewMouseMove(X, Y: Single; Down: Boolean): Boolean; virtual;
    function PreviewMouseUp(X, Y: Single): Boolean; virtual;
    function PreviewMouseWheel(Delta: Integer): Boolean; virtual;
    function RenderPreview: Boolean; virtual;
    function IsAncestorOf(Descendant: TAHMUIObject): Boolean;
    function IsEligibleAncestor(Child: TAHMUIObject): Boolean;
    function ModifyActions: Integer; virtual;
    function Modify(Action: Integer = 0): Boolean; virtual;
    function ModifyValue(var Value: String; const Parameter: String): Boolean; virtual;
    function ModifyCaption(Action: Integer = 0): String; virtual;
    procedure SeedObject; virtual;
    procedure Assign(Source: TPersistent); override;
    procedure AssignContents(Source: TAHMUIObject); virtual;
    procedure SaveAsXML(Lines: TStrings); virtual;
    procedure SaveXMLComments(Lines: TStrings);
    procedure SaveXMLBody(Lines: TStrings); virtual;
    procedure ParseCommonXML(XML: TAHMXMLHelper); virtual;
    procedure ParseFromXML(XML: TAHMXMLHelper); virtual;
    procedure ReparseFromXML(XML: TAHMXMLHelper);
    procedure Revert;
    procedure Rename(Name: String); virtual;
    procedure Remove; virtual;
    procedure InvalidateUIObject(UIObject: TAHMUIObject); virtual;
    procedure DeleteUIObject(UIObject: TAHMUIObject); virtual;
    procedure BuildProperties(Properties: TAHMUIPropertyList); virtual;
    function XMLReference(TagName: String = ''): String;
    class function ClassName: ShortString; virtual;
  published
    property Name: String read FName write Rename;
    property Description: String read FDescription write FDescription;
    property Comment: TAHMMemoString read FComment write FComment;
    property Ancestor: TAHMUIObject read FAncestor write SetAncestor;
    property DesignerPos: String read GetDesignerPos write SetDesignerPos;
    property DesignerSize: String read GetDesignerSize write SetDesignerSize;
    property DesignerRot: String read GetDesignerRot write SetDesignerRot;
  end;

  TAHMUIDisplayObject = class (TAHMUIObject)
  private
    FWidth: Single;
    FHeight: Single;
    FFullscreen: Boolean;
    FEditable: Boolean;
    FPreviewClass: TClass;
    FPreviewText: String;
  protected
    FVirtWidth: Integer;
    FVirtHeight: Integer;
    property PreviewFullscreen: Boolean read FFullscreen write FFullscreen;
    property PreviewControlClass: TClass read FPreviewClass write FPreviewClass;
    property PreviewDisplayText: String read FPreviewText write FPreviewText;
    function GetDesignerSize: String; override;
    procedure SetDesignerSize(Size: String); override;
    procedure SetVirtualWidth(Width: Integer); virtual;
    procedure SetVirtualHeight(Height: Integer); virtual;
    procedure ClearProperties; override;
  public
    constructor Create(const Name: String); override;
    property Width: Single read FWidth write FWidth;
    property Height: Single read FHeight write FHeight;
    property PreviewEditable: Boolean read FEditable write FEditable;
    function DesignerAdjustSize(DX, DY: Integer): Boolean; override;
    function RenderPreview: Boolean; override;
    function PreviewRect: TAHMRectF;
    procedure ConfigurePreview(Control: TObject); virtual;
    procedure PreRender(Control: TObject); overload;
    procedure PreRender(Control: TObject; iX, iY, iWidth, iHeight: Single); overload; virtual;
    procedure Render(Control: TObject); overload;
    procedure Render(Control: TObject; iX, iY, iWidth, iHeight: Single); overload; virtual;
    procedure Render(Control: TObject; iX, iY, iWidth, iHeight: Single; Clip: Boolean); overload; virtual;
    procedure Assign(Source: TPersistent); override;
    property VirtualWidth: Integer read FVirtWidth write SetVirtualWidth;
    property VirtualHeight: Integer read FVirtHeight write SetVirtualHeight;
  end;

  TAHMUIObjectClass = class of TAHMUIObject;

  TAHMUIObjectList = class(TPersistent)
  private
    FObjects: TStringList;
    FOwner: TAHMUIObject;
    FDescription: String;
    FComment: TAHMMemoString;
    FBaseList: TAHMUIObjectList;
    FChildClass: TAHMUIObjectClass;
    FDefaultSort: TAHMUIObjectListSort;
    FCurrentSort: TAHMUIObjectListSort;
    FXMLTagName: String;
    FXMLIndent: Integer;
    FOnModified: TNotifyEvent;
  protected
    FEmptyObject: TAHMUIObject;
    FDefaultObject: TAHMUIObject;
    FDefaultObjects: TAHMUIStateObjectList;
    FSpaceElements: Boolean;
    function GetText: String;
    function GetEmptyObject: TAHMUIObject;
    function GetDefaultObject: TAHMUIObject;
    function GetDefaultObjects(const State: String): TAHMUIObject;
    function GetCount: Integer;
    function GetTotalCount: Integer;
    function GetObject(Index: Integer): TAHMUIObject; overload;
    function BeginTag: String;
    function EndTag: String;
    function ClassFromTag(TagName: String): TAHMUIObjectClass; virtual;
    procedure SetCurrentSort(SortOrder: TAHMUIObjectListSort);
    procedure DoModified;
    property InternalObjects: TStringList read FObjects;
    property EmptyObject: TAHMUIObject read GetEmptyObject;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure FreeWithContents;
    property OnModified: TNotifyEvent read FOnModified write FOnModified;
    property Owner: TAHMUIObject read FOwner write FOwner;
    property Description: String read FDescription write FDescription;
    property Comment: TAHMMemoString read FComment write FComment;
    property BaseList: TAHMUIObjectList read FBaseList write FBaseList;
    property ChildClass: TAHMUIObjectClass read FChildClass write FChildClass;
    property XMLTagName: String read FXMLTagName write FXMLTagName;
    property XMLIndent: Integer read FXMLIndent write FXMLIndent;
    property Text: String read GetText;
    property Count: Integer read GetCount;
    property TotalCount: Integer read GetTotalCount;
    property Objects[Index: Integer]: TAHMUIObject read GetObject; default;
    property DefaultObject: TAHMUIObject read GetDefaultObject;
    property DefaultObjects[const State: String]: TAHMUIObject read GetDefaultObjects;
    property DefaultSort: TAHMUIObjectListSort read FDefaultSort write FDefaultSort;
    property CurrentSort: TAHMUIObjectListSort read FCurrentSort write SetCurrentSort;
    procedure SortObjects;
    procedure Clear;
    procedure ClearObjects;
    procedure InsertObject(UIObject: TAHMUIObject; const State: String = '');
    procedure RemoveObject(UIObject: TAHMUIObject);
    function Exchange(First, Second: Integer): Boolean;
    function Move(From, Before: Integer): Boolean;
    function MoveUp(Index: Integer): Boolean;
    function MoveDown(Index: Integer): Boolean;
    function Delete(Index: Integer): Boolean;
    function Add(UIObject: TAHMUIObject): Integer;
    function AddObject(const State: String; UIObject: TAHMUIObject): Integer;
    function Contains(UIObject: TAHMUIObject): Boolean;
    function IndexOf(const Name: String): Integer; overload;
    function IndexOf(const Name: String; ReqClass: TAHMUIObjectClass): Integer; overload;
    function IndexOf(UIObject: TAHMUIObject): Integer; overload;
    function Inherit(const SourceName, DestName: String): TAHMUIObject; overload;
    function Inherit(const SourceName, DestName: String; DestClass: TAHMUIObjectClass): TAHMUIObject; overload;
    function CreateDefault(DestClass: TAHMUIObjectClass): TAHMUIObject;
    function CreateCopy(UIObject: TAHMUIObject): TAHMUIObject;
    function GetObject(const Name: String): TAHMUIObject; overload;
    function GetObject(const Name: String; ReqClass: TAHMUIObjectClass): TAHMUIObject; overload;
    function IsDifferent(BaseList: TAHMUIObjectList): Boolean;
    function ValidateObjectName(PotentialName: String): String;
    function GenerateObjectName(PrefixName: String): String;
    function Modify: Boolean; virtual;
    function ModifyName(var Name: String; const Parameter: String): Boolean; virtual;
    function RequiresSaving: Boolean; virtual;
    procedure Assign(Source: TPersistent); override;
    procedure AssignContents(Source: TAHMUIObjectList);
    procedure SaveAsXML(Lines: TStrings);
    procedure SaveDiffsAsXML(BaseList: TAHMUIObjectList; Lines: TStrings);
    procedure ParseFromXML(XML: TAHMXMLHelper); virtual;
    procedure ParseObjectFromXML(UIObject: TAHMUIObject; XML: TAHMXMLHelper);
    procedure ListContents(Lines: TStrings);
    procedure ListObjects(Lines: TStrings);
    procedure InvalidateUIObject(UIObject: TAHMUIObject);
    procedure DeleteUIObject(UIObject: TAHMUIObject);
    procedure PopulateDefaultObjects; virtual;
    procedure CleardownDefaultObjects; virtual;
    class function ClassName: ShortString; virtual;
  end;

  TAHMUIStateObjectList = class(TAHMUIObjectList)
  private
    FSelected: String;
    FDisplayClassName: String;
    FObjectTypes: TAHMUIObjectTypes;
    FStateType: TAHMUIStateType;
  protected
    function GetState(Index: Integer): String; overload;
  public
    property States[Index: Integer]: String read GetState;
    property SelectedState: String read FSelected write FSelected;
    property DisplayClassName: String read FDisplayClassName write FDisplayClassName;
    property ObjectTypes: TAHMUIObjectTypes read FObjectTypes write FObjectTypes;
    property StateType: TAHMUIStateType read FStateType write FStateType;
    procedure DeleteState(const State: String);
    function GetState(const State: String): TAHMUIObject; overload;
    function GetStateObject(State: TAHMControlState; Checked: Boolean): TAHMUIObject;
    function Modify: Boolean; override;
    procedure ListStates(Lines: TStrings); virtual;
  end;

  procedure LogParsingError(ErrorMsg: String; Source: TPersistent);

implementation

uses
  Windows, Math, ApplicationManager, Screen, BaseControls, Logging, Canvas,
  {$IFDEF DESIGNER}DesignerStateList,{$ENDIF} Utilities, TagNames, XMLTags;


procedure LogParsingError(ErrorMsg: String; Source: TPersistent);
begin
  if Source is TAHMUIObject then
    with Source as TAHMUIObject do
    begin
      ErrorMsg := ClassName + ': ' + Name + ' (' + Description + ') - ' + ErrorMsg;
      State := osError;
    end
  else if Source is TAHMUIObjectList then
    with Source as TAHMUIObjectList do
      ErrorMsg := ClassName + ': ' + Description + ' - ' + ErrorMsg;

  LogError('Theme parsing error encountered: ' + ErrorMsg);

  // Delegate to application manager to handle
  ApplicationManagerInstance.LogParseError(ErrorMsg, Source);
end;

//----------------------------------------------------------------------------//

// TAHMUIPropertyList

constructor TAHMUIPropertyList.Create;
begin
  inherited;

  FList := TList.Create;
end;

destructor TAHMUIPropertyList.Destroy;
begin
  Clear;
  FList.Free;

  inherited;
end;

function TAHMUIPropertyList.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TAHMUIPropertyList.GetProperty(Index: Integer): TAHMUIProperty;
begin
  if (Index >= 0) and (Index < FList.Count) then
    Result := TAHMUIProperty(FList[Index])
  else
    Result := nil;
end;

procedure TAHMUIPropertyList.Add(DisplayName, PropertyName, Category, HintText: String);
var
  NewProperty: TAHMUIProperty;
begin
  NewProperty := TAHMUIProperty.Create;
  NewProperty.DisplayName := DisplayName;
  NewProperty.PropertyName := PropertyName;
  NewProperty.Category := Category;
  NewProperty.HintText := HintText;
  FList.Add(NewProperty);
end;

procedure TAHMUIPropertyList.Remove(PropertyName: String);
var
  i: Integer;
begin
  // Remove specified property from our property list
  for i := 0 to Pred(FList.Count) do
    if TAHMUIProperty(FList[i]).PropertyName = PropertyName then
    begin
      TAHMUIProperty(FList[i]).Free;
      FList.Delete(i);
      Break;
    end;
end;

procedure TAHMUIPropertyList.Clear;
var
  i: Integer;
begin
  for i := 0 to Pred(FList.Count) do
    TAHMUIProperty(FList[i]).Free;

  FList.Clear;
end;

//----------------------------------------------------------------------------//
constructor TAHMUIObjectList.Create;
begin
  inherited Create;

  // Setup custom properties
  FChildClass := TAHMUIObject;
  FDefaultSort := lsAlpha;
  FSpaceElements := True;

  FObjects := TStringList.Create;
end;

destructor TAHMUIObjectList.Destroy;
begin
  // Release our empty object instance
  FEmptyObject.Free;
  FObjects.Free;

  // Cleanup default object list if we created it
  if Assigned(FDefaultObjects) then
  begin
    CleardownDefaultObjects;
    FDefaultObjects.FreeWithContents;
  end;

  inherited Destroy;
end;

procedure TAHMUIObjectList.FreeWithContents;
begin
  if Self <> nil then
    try
      ClearObjects;
      Destroy;
    except
      // This very rarely causes an exception, so catch it here
    end;
end;

function TAHMUIObjectList.GetText: String;
var
  i: Integer;
begin
  Result := '';

  // Append names and designer info for all items
  for i := 0 to Pred(TotalCount) do
    with TAHMUIObject(Objects[i]) do
      Result := Result + Name + ': ' + DesignerInfo + sLineBreak;
end;

function TAHMUIObjectList.GetEmptyObject: TAHMUIObject;
begin
  // Create empty object instance on demand (if not already done elsewhere)
  if not Assigned(FEmptyObject) then
    FEmptyObject := ChildClass.Create('');
  Result := FEmptyObject;
end;

function TAHMUIObjectList.GetDefaultObject: TAHMUIObject;
begin
  if Assigned(FBaseList) then
  begin
    // Default object is a singleton, so we can share base list instance
    Result := FBaseList.GetDefaultObject
  end
  else if Assigned(FDefaultObject) then
    Result := FDefaultObject
  else
  begin
    // Create default object list on demand and cache default instance
    Result := GetDefaultObjects('');
    FDefaultObject := Result;
  end;
end;

function TAHMUIObjectList.GetDefaultObjects(const State: String): TAHMUIObject;
begin
  if Assigned(FBaseList) then
  begin
    // Default object list is a singleton, so we can share base list instance
    Result := FBaseList.GetDefaultObjects(State);
  end
  else
  begin
    // Create default objects list on demand (if not already done elsewhere)
    if not Assigned(FDefaultObjects) then
    begin
      FDefaultObjects := TAHMUIStateObjectList.Create;
      PopulateDefaultObjects;
    end;

    // Create default object state instances on demand too
    Result := FDefaultObjects.GetState(State);
    if Result = nil then
    begin
      Result := ChildClass.Create('');
      FDefaultObjects.AddObject(State, Result);
    end;
  end;
end;

function TAHMUIObjectList.GetCount: Integer;
begin
  Result := FObjects.Count;
end;

function TAHMUIObjectList.GetTotalCount: Integer;
begin
  // Return combined count of ourselves and baselist
  if Assigned(FBaseList) then
    Result := Self.Count + FBaseList.Count
  else
    Result := Self.Count;
end;

function TAHMUIObjectList.GetObject(Index: Integer): TAHMUIObject;
begin
  // If we have a baselist assigned treat it as a concatenation to our list
  if (Index >= Count) and Assigned(FBaseList) then
    Result := FBaseList.Objects[Index - Count]
  else
    Result := TAHMUIObject(FObjects.Objects[Index]);
end;

procedure TAHMUIObjectList.SetCurrentSort(SortOrder: TAHMUIObjectListSort);
begin
  // Ignore sort request unless default order is specified
  if FDefaultSort = lsNatural then Exit;

  if FCurrentSort <> SortOrder then
  begin
    FCurrentSort := SortOrder;
    SortObjects;
  end;
end;

function ObjectListCompareNames(List: TStringList; Index1, Index2: Integer): Integer;
var
  Item1, Item2: TAHMUIObject;
begin
  // Obtain two UIObject instances to compare
  Item1 := TAHMUIObject(List.Objects[Index1]);
  Item2 := TAHMUIObject(List.Objects[Index2]);

  // Compare names to determine sort order
  Result := AnsiCompareText(Item1.Name, Item2.Name);
end;

procedure ObjectListSortDependencies(List: TStringList);
var
  i, j, InsertPoint: Integer;
  Dependencies: Boolean;
  Item: TAHMUIObject;
begin
  // Check list has enough items to require sorting
  if List.Count < 2 then Exit;

  InsertPoint := 0;

  // First pass - look for objects with no ancestor
  for i := 0 to Pred(List.Count) do
    if TAHMUIObject(List.Objects[i]).Ancestor = nil then
    begin
      // Move this object to the front of the list
      if i <> InsertPoint then List.Exchange(i, InsertPoint);
      Inc(InsertPoint);
    end;

  // Second pass - look for objects with no ancestors in unsorted list
  while InsertPoint < List.Count do
  begin
    for i := InsertPoint to Pred(List.Count) do
    begin
      Item := TAHMUIObject(List.Objects[i]);
      Dependencies := False;

      // Look for this objects ancestor in unsorted part of list
      for j := InsertPoint to Pred(List.Count) do
        if Item.Ancestor = List.Objects[j] then
        begin
          // Reject this item - it has dependencies
          Dependencies := True;
          Break;
        end;

      // If this object has no depencies then move to front of list
      if not Dependencies then
      begin
        if i <> InsertPoint then List.Exchange(i, InsertPoint);
        Break;
      end;
    end;

    // Increment insertion point regardless of whether we found an item, just
    // in case ancestor pointers are really messed up to avoid infinite loop
    Inc(InsertPoint);
  end;
end;

procedure TAHMUIObjectList.SortObjects;
begin
  // Change to alpha sort if supported on first sort
  if (FDefaultSort = lsAlpha) and (FCurrentSort = lsNatural) then
    FCurrentSort := FDefaultSort;

  // Sort object list according to current sort order
  case FCurrentSort of
    lsAlpha: FObjects.CustomSort(ObjectListCompareNames);
    lsDependencies: ObjectListSortDependencies(FObjects);
  end;
end;

procedure TAHMUIObjectList.Clear;
begin
  // Note this leaves any associated objects in memory
  FObjects.Clear;
end;

procedure TAHMUIObjectList.ClearObjects;
var
  i: Integer;
begin
  // Free every object contained within our list
  for i := Pred(Count) downto 0 do
    FObjects.Objects[i].Free;
  FObjects.Clear;
end;

procedure TAHMUIObjectList.InsertObject(UIObject: TAHMUIObject; const State: String);
begin
  // Insert existing object instance in our list
  if Assigned(UIObject) then
  begin
    // If object has an ancestor add it to the end of the list,
    // otherwise add it to the start in case it has derived objects
    if UIObject.Ancestor <> nil then FObjects.AddObject(State, UIObject)
                                else FObjects.InsertObject(0, State, UIObject);

    // Take ownership of this object
    UIObject.Owner := Self;
    DoModified;
  end;
end;

procedure TAHMUIObjectList.RemoveObject(UIObject: TAHMUIObject);
begin
  // Remove specified object from list, but don't free it
  Delete(FObjects.IndexOfObject(UIObject));
end;

function TAHMUIObjectList.Exchange(First, Second: Integer): Boolean;
begin
  // Set default result - invalid indices
  Result := False;

  // Swap specified list items
  if (First >= 0) and (Second >= 0) and (First <> Second) and
     (First < FObjects.Count) and (Second < FObjects.Count) then
  begin
    FObjects.Exchange(First, Second);

    DoModified;
    Result := True;
  end;
end;

function TAHMUIObjectList.Move(From, Before: Integer): Boolean;
begin
  // Set default result - invalid indices
  Result := False;

  // Move item to specified insertion point
  if (From >= 0) and (From < FObjects.Count) and (Before >= 0) and
     (Before <= FObjects.Count) and (From <> Before) then
  begin
    FObjects.InsertObject(Before, FObjects[From], FObjects.Objects[From]);
    if From > Before then FObjects.Delete(From + 1)
                     else FObjects.Delete(From);

    DoModified;
    Result := True;
  end;
end;

function TAHMUIObjectList.MoveUp(Index: Integer): Boolean;
begin
  // Delegate to method above
  Result := Exchange(Index, Index - 1);
end;

function TAHMUIObjectList.MoveDown(Index: Integer): Boolean;
begin
  // Delegate to method above
  Result := Exchange(Index, Index + 1);
end;

function TAHMUIObjectList.Delete(Index: Integer): Boolean;
begin
  // Remove specified object from list, but don't free it
  if (Index >= 0) and (Index < FObjects.Count) then
  begin
    FObjects.Delete(Index);

    DoModified;
    Result := True;
  end
  else
    Result := False;
end;

function TAHMUIObjectList.Add(UIObject: TAHMUIObject): Integer;
begin
  // Don't add nil objects to the list
  if Assigned(UIObject) then
  begin
    Result := FObjects.AddObject('', UIObject);
    DoModified;
  end
  else
    Result := -1;
end;

function TAHMUIObjectList.AddObject(const State: String; UIObject: TAHMUIObject): Integer;
begin
  // Don't add nil objects to the list
  if Assigned(UIObject) then
  begin
    Result := FObjects.AddObject(State, UIObject);
    DoModified;
  end
  else
    Result := -1;
end;

function TAHMUIObjectList.IndexOf(const Name: String): Integer;
var
  i: Integer;
begin
  // Set default result - not found
  Result := -1;

  // Check whether object name is in our list
  for i := 0 to Pred(FObjects.Count) do
    if AnsiSameText(TAHMUIObject(FObjects.Objects[i]).Name, Name) then
    begin
      Result := i;
      Exit;
    end;
end;

function TAHMUIObjectList.IndexOf(const Name: String; ReqClass: TAHMUIObjectClass): Integer;
var
  i: Integer;
begin
  // Set default result - not found
  Result := -1;

  // Check whether object name is in our list
  for i := 0 to Pred(FObjects.Count) do
    if (FObjects.Objects[i] is ReqClass) and
       AnsiSameText(TAHMUIObject(FObjects.Objects[i]).Name, Name) then
    begin
      Result := i;
      Exit;
    end;
end;

function TAHMUIObjectList.IndexOf(UIObject: TAHMUIObject): Integer;
var
  i: Integer;
begin
  // Set default result - not found
  Result := -1;

  // Check whether object name is in our list
  for i := 0 to Pred(FObjects.Count) do
    if FObjects.Objects[i] = UIObject then
    begin
      Result := i;
      Exit;
    end;
end;

function TAHMUIObjectList.Contains(UIObject: TAHMUIObject): Boolean;
var
  i: Integer;
begin
  // Set default result - not found
  Result := False;

  // Check whether passed object is in our list
  for i := 0 to Pred(Count) do
    if Objects[i] = UIObject then
    begin
      Result := True;
      Exit;
    end;

  // If not yet found then check in our base list
  if FBaseList <> nil then
    for i := 0 to Pred(FBaseList.Count) do
      if FBaseList.Objects[i] = UIObject then
      begin
        Result := True;
        Break;
      end;
end;

function TAHMUIObjectList.Inherit(const SourceName, DestName: String): TAHMUIObject;
begin
  // Defer to method below using default child class type
  Result := Inherit(SourceName, DestName, FChildClass);
end;

function TAHMUIObjectList.Inherit(const SourceName, DestName: String; DestClass: TAHMUIObjectClass): TAHMUIObject;
var
  oObject: TAHMUIObject;
begin
  // Lookup ancestor object
  oObject := Nil;
  if SourceName <> '' then oObject := GetObject(SourceName);

  // Ensure destination class is compatible with inherited object
  if (oObject <> nil) and (not DestClass.InheritsFrom(oObject.ClassType)) then
    if (not DestClass.InheritsFrom(TAHMImmutableControl)) then
      DestClass := TAHMUIObjectClass(oObject.ClassType);

  // Create new empty object
  Result := DestClass.Create(DestName);
  Result.Owner := Self;
  Add(Result);

  // Populate properties from inherited object if we found one
  if (oObject <> nil) then Result.Assign(oObject);

  // Fix inheritance for new object
  Result.Ancestor := oObject;
end;

function TAHMUIObjectList.CreateDefault(DestClass: TAHMUIObjectClass): TAHMUIObject;
begin
  // Set default result - existing default object
  Result := GetObject(DEFAULT_OBJECT_NAME);

  // Doesn't exist, so add with default properties
  if not Assigned(Result) then
  begin
    Result := Inherit('', DEFAULT_OBJECT_NAME, DestClass);
    Result.SeedObject;
    Result.Description := 'Default ' + ClassName;
  end;
end;

function TAHMUIObjectList.CreateCopy(UIObject: TAHMUIObject): TAHMUIObject;
begin
  // Set default result - failed to create a copy
  Result := nil;

  if Assigned(UIObject) then
  begin
    Result := Inherit(UIObject.Name, GenerateObjectName(UIObject.Name));

    // Now object is cloned we can break it's inheritance
    Result.Ancestor := UIObject.Ancestor;
  end;
end;

function TAHMUIObjectList.GetObject(const Name: String): TAHMUIObject;
var
  i: Integer;
begin
  i := IndexOf(Name);

  // If not found then try in base list (if assigned)
  if (i <> -1) then
    Result := TAHMUIObject(Objects[i])
  else
    if FBaseList <> nil then
      Result := FBaseList.GetObject(Name)
    else
      Result := nil;
end;

function TAHMUIObjectList.GetObject(const Name: String; ReqClass: TAHMUIObjectClass): TAHMUIObject;
var
  i: Integer;
begin
  i := IndexOf(Name, ReqClass);

  // If not found then try in base list (if assigned)
  if (i <> -1) then
    Result := TAHMUIObject(Objects[i])
  else
    if FBaseList <> nil then
      Result := FBaseList.GetObject(Name, ReqClass)
    else
      Result := nil;
end;

function TAHMUIObjectList.IsDifferent(BaseList: TAHMUIObjectList): Boolean;
var
  i: Integer;
begin
  // Set default result - lists are the same
  Result := False;

  if Assigned(BaseList) and (Count > 0) then
    if BaseList.Count <> Count then
      // Different counts must mean different content
      Result := True
    else
      // Same count so compare each name/object instance
      for i := 0 to Pred(Count) do
        if (FObjects[i] <> BaseList.InternalObjects[i]) or
           (FObjects.Objects[i] <> BaseList.InternalObjects.Objects[i]) then
        begin
          Result := True;
          Break;
        end;
end;

function TAHMUIObjectList.ValidateObjectName(PotentialName: String): String;
begin
  // Trim any spaces from candidate name
  Result := Trim(PotentialName);

  // This name is okay so long as it's not a duplicate
  if (Length(Result) < 1) or (IndexOf(Result) >= 0) then Result := '';
end;

function TAHMUIObjectList.GenerateObjectName(PrefixName: String): String;
var
  Suffix: Integer;
begin
  // Remove any trailing digits from the prefix
  while Length(PrefixName) > 0 do
    if PrefixName[Length(PrefixName)] in ['0'..'9'] then
      PrefixName := Copy(PrefixName, 1, Length(PrefixName) - 1)
    else
      Break;

  // Now append a unique numeric suffix to the prefix
  Suffix := 1;
  repeat
    Inc(Suffix);
  until GetObject(PrefixName + IntToStr(Suffix)) = nil;

  // Okay, this is now a unique name
  Result := PrefixName + IntToStr(Suffix);
end;

function TAHMUIObjectList.Modify: Boolean;
begin
  // Descendants will implement this method
  Result := False;
end;

function TAHMUIObjectList.ModifyName(var Name: String; const Parameter: String): Boolean;
begin
  // Descendants will implement this method
  Result := False;
end;

procedure TAHMUIObjectList.Assign(Source: TPersistent);
begin
  // Share same object instances as the specified source list - use with care!
  // Note that this method does not free any existing object references!
  if Source is TAHMUIObjectList then
    with Source as TAHMUIObjectList do
    begin
      Self.OnModified := OnModified;
      Self.Owner := Owner;
      Self.Description := Description;
      Self.Comment := Comment;
      Self.BaseList := BaseList;
      Self.ChildClass := ChildClass;
      Self.XMLTagName := XMLTagName;
      Self.XMLIndent := XMLIndent;
      Self.DefaultSort := DefaultSort;
      Self.CurrentSort := CurrentSort;
      Self.InternalObjects.Assign(InternalObjects);
    end;
end;

procedure TAHMUIObjectList.AssignContents(Source: TAHMUIObjectList);
var
  i: Integer;
  oOld, oNew: TAHMUIObject;
  DestClass: TAHMUIObjectClass;
begin
  // Clear existing objects first
  ClearObjects;

  // Assign properties and object instances from source
  Assign(Source);

  // Replace each object with a new copied instance
  for i := 0 to Pred(FObjects.Count) do
  begin
    oOld := TAHMUIObject(FObjects.Objects[i]);
    if Assigned(oOld) then
    begin
      DestClass := TAHMUIObjectClass(oOld.ClassType);
      oNew := DestClass.Create(oOld.Name);
      oNew.AssignContents(oOld);
      oNew.Owner := Self;
      FObjects.Objects[i] := oNew;
    end;
  end;
end;

function TAHMUIObjectList.BeginTag: String;
begin
  // Construct XML begin tag with description attributes
  if (FDescription <> '') then
    Result := TGB + XmlTagName + SPC + ATTR_DESC + ATB + EncodeXML(FDescription) + ATC
  else
    Result := TGB + XmlTagName + TGC;
end;

function TAHMUIObjectList.EndTag: String;
begin
  // Construct XML end tag
  Result := TGE + XmlTagName + TGC;
end;

function TAHMUIObjectList.RequiresSaving: Boolean;
begin
  // Descendants may be more discerning if required
  Result := Count > 0;
end;

procedure TAHMUIObjectList.SaveAsXML(Lines: TStrings);
var
  i: Integer;
begin
  // Defer to method below with empty comparison list (i.e. include all)
  if RequiresSaving then SaveDiffsAsXML(nil, Lines);

  // Clear modification flag for all owned objects
  for i := 0 to Pred(Count) do
    TAHMUIObject(Objects[i]).Modified := False;
end;

procedure TAHMUIObjectList.SaveDiffsAsXML(BaseList: TAHMUIObjectList; Lines: TStrings);
var
  i: Integer;
begin
  // Create empty object instance if not already done elsewhere
  GetEmptyObject;

  // Add list tags with XML elements for each UI object in list (unless empty)
  if Count > 0 then
  begin
    // Add blank line, comment and begin tag
    if FXMLIndent = 0 then Lines.Add('');
    if Comment <> '' then
      FormatXMLComment(Comment, FXMLIndent + 1, Lines);
    if FXMLTagName <> '' then
      Lines.Add(TABS[FXMLIndent + 1] + BeginTag);

    // Save XML in dependencies order
    SetCurrentSort(lsDependencies);
    try
      // Add each owned UI object
      if FXMLIndent = 0 then Lines.Add('');
      for i := 0 to Pred(Count) do
      begin
        // Skip items already in comparison list
        if Assigned(BaseList) and BaseList.Contains(TAHMUIObject(Objects[i])) then Continue;

        TAHMUIObject(Objects[i]).XMLIndent := FXMLIndent;
        TAHMUIObject(Objects[i]).SaveAsXML(Lines);
        if FSpaceElements then Lines.Add('');
      end;
    finally
      SetCurrentSort(FDefaultSort);
    end;

    if (not FSpaceElements) and (FXMLIndent = 0) then Lines.Add('');

    // Add closing tag and blank line
    if FXMLTagName <> '' then
      Lines.Add(TABS[FXMLIndent + 1] + EndTag);
    if FXMLIndent = 0 then Lines.Add('');
  end;
end;

function TAHMUIObjectList.ClassFromTag(TagName: String): TAHMUIObjectClass;
begin
  // Default implementation - use our standard base class regardless of tag
  Result := FChildClass;
end;

procedure TAHMUIObjectList.DoModified;
begin
  // Call onmodified event if assigned
  if Assigned(FOnModified) then FOnModified(Self);
end;

procedure TAHMUIObjectList.ParseFromXML(XML: TAHMXMLHelper);
var
  RootNode, ItemNode: TAHMXMLNode;
begin
  // Store description, comments & prepare for parsing
  FDescription := XML.GetAttribute(ATTR_DESC);
  FComment := XML.CurrentComment;
  RootNode := XML.CurrentNode;
  ItemNode := nil;

  // Keep going as long as we find child tags to process
  while XML.NextElement(RootNode, ItemNode) do
  begin
    // Use method below to parse an individual object
    ParseObjectFromXML(nil, XML);
  end;
end;

procedure TAHMUIObjectList.ParseObjectFromXML(UIObject: TAHMUIObject; XML: TAHMXMLHelper);
var
  sName, sInherit, sDesc, sComment: String;
  Ancestor: TAHMUIObject;
  ItemClass: TAHMUIObjectClass;
begin
  // Get standard object attributes
  sName    := XML.GetAttribute(ATTR_NAME);
  sInherit := XML.GetAttribute(ATTR_INHERIT);
  sDesc    := XML.GetAttribute(ATTR_DESC);
  sComment := XML.CurrentComment;

  // If passed a nil object then we'll build a new instance
  if UIObject = nil then
  begin
    // Try to find an appropriate class for this tag
    ItemClass := ClassFromTag(XML.CurrentElement);

    // Ignore any tags we can't map to classes
    if ItemClass <> nil then
    begin
      // Construct a new object instance with relevant details
      UIObject := Inherit(sInherit, sName, ItemClass);
    end;
  end
  else
  begin
    // Check for name change
    if (sName <> '') and (sName <> UIObject.Name) then
      UIObject.Rename(sName);

    // Reapply ancestor properties if assigned
    if sInherit = '' then UIObject.Ancestor := nil
    else
    begin
      Ancestor := GetObject(sInherit);
      if Ancestor <> nil then UIObject.Assign(Ancestor);

      // Fix inheritance for new object
      UIObject.Ancestor := Ancestor;
    end;
  end;

  // Apply description and comment to UI object
  if sDesc <> '' then UIObject.Description := sDesc;
  if sComment <> '' then UIObject.Comment := sComment;

  // Allow object to parse its own custom properties
  UIObject.ParseFromXML(XML);
end;

procedure TAHMUIObjectList.ListContents(Lines: TStrings);
var
  i: Integer;
  Obj: TAHMUIObject;
  sWork: String;
begin
  // Dump a list of owned objects
  for i := 0 to Pred(TotalCount) do
  begin
    Obj := TAHMUIObject(Objects[i]);
    sWork := Obj.Name;
    if Obj.Description <> '' then sWork := sWork + ' - ' + Trim(Obj.Description);
    if Obj.Comment <> '' then sWork := sWork + ' (' + Trim(Obj.Comment) + ')';
    Lines.Add(sWork);
  end;
end;

procedure TAHMUIObjectList.ListObjects(Lines: TStrings);
var
  i: Integer;
  Obj: TAHMUIObject;
begin
  // Dump a list of owned objects
  for i := 0 to Pred(TotalCount) do
  begin
    Obj := TAHMUIObject(Objects[i]);
    Lines.AddObject(Obj.Name, Obj);
  end;
end;

procedure TAHMUIObjectList.InvalidateUIObject(UIObject: TAHMUIObject);
var
  i: Integer;
begin
  // Pass notification to all objects in the list
  for i := 0 to Pred(Count) do
    Objects[i].InvalidateUIObject(UIObject);
end;

procedure TAHMUIObjectList.DeleteUIObject(UIObject: TAHMUIObject);
var
  i: Integer;
begin
  // Pass notification to all objects in the list
  for i := Pred(Count) downto 0 do
    Objects[i].DeleteUIObject(UIObject);
end;

procedure TAHMUIObjectList.PopulateDefaultObjects;
begin
  // Descendants can configure their own default objects
end;

procedure TAHMUIObjectList.CleardownDefaultObjects;
begin
  // Descendants can cleanup their own default objects
end;

class function TAHMUIObjectList.ClassName: ShortString;
var
  Name: ShortString;
  i: Integer;
begin
  Name := inherited ClassName;

  // Remove TAHM prefix from name
  if Copy(Name, 1, 4) = 'TAHM' then
    Name := Copy(Name, 5, Length(Name));

  // Remove List suffix from name
  if Copy(Name, Length(Name) - 3, 4) = 'List' then
    Name := Copy(Name, 1, Length(Name) - 4);

  // Insert spaces before camel cased words
  Result := Copy(Name, 1, 1);
  for i := 2 to Length(Name) do
    if Name[i] in ['A'..'Z'] then Result := Result + ' ' + Name[i]
                             else Result := Result + Name[i];
end;

//----------------------------------------------------------------------------//

procedure TAHMUIStateObjectList.DeleteState(const State: String);
var
  i: Integer;
begin
  i := FObjects.IndexOf(State);

  // If not found then try in base list (if assigned)
  if i >= 0 then
    FObjects.Delete(i)
  else
    if FBaseList is TAHMUIStateObjectList then
      TAHMUIStateObjectList(FBaseList).DeleteState(State)
end;

function TAHMUIStateObjectList.GetState(Index: Integer): String;
begin
  // If we have a baselist assigned treat it as a concatenation to our list
  if (Index >= Count) and (FBaseList is TAHMUIStateObjectList) then
    Result := TAHMUIStateObjectList(FBaseList).States[Index - Count]
  else
    Result := FObjects[Index];
end;

function TAHMUIStateObjectList.GetState(const State: String): TAHMUIObject;
var
  i: Integer;
begin
  i := FObjects.IndexOf(State);

  // If not found then try in base list (if assigned)
  if i >= 0 then
    Result := TAHMUIObject(Objects[i])
  else
    if FBaseList is TAHMUIStateObjectList then
      Result := TAHMUIStateObjectList(FBaseList).GetState(State)
    else
      Result := nil;
end;

function TAHMUIStateObjectList.GetStateObject(State: TAHMControlState; Checked: Boolean): TAHMUIObject;
begin
  Result := nil;

  // Find best match for specified state
  if Checked then
  begin
    if State = csIdle then
    begin
      Result := GetState(STATE_VAL_IDLE_CHECK);
      if Result = nil then
        Result := GetState(STATE_VAL_IDLE);
    end
    else if State = csFocused then
    begin
      Result := GetState(STATE_VAL_FOCUS_CHECK);
      if Result = nil then
        Result := GetState(STATE_VAL_IDLE_CHECK);
      if Result = nil then
        Result := GetState(STATE_VAL_IDLE);
    end
    else if State = csPressed then
    begin
      Result := GetState(STATE_VAL_PRESS_CHECK);
      if Result = nil then
        Result := GetState(STATE_VAL_FOCUS_CHECK);
      if Result = nil then
        Result := GetState(STATE_VAL_IDLE_CHECK);
      if Result = nil then
        Result := GetState(STATE_VAL_IDLE);
    end
    else if State = csDisabled then
    begin
      Result := GetState(STATE_VAL_DISABLE_CHECK);
      if Result = nil then
        Result := GetState(STATE_VAL_IDLE_CHECK);
      if Result = nil then
        Result := GetState(STATE_VAL_IDLE);
    end;
  end
  else
  begin
    if State = csIdle then
      Result := GetState(STATE_VAL_IDLE)
    else if State = csFocused then
    begin
      Result := GetState(STATE_VAL_FOCUS);
      if Result = nil then
        Result := GetState(STATE_VAL_IDLE);
    end
    else if State = csPressed then
    begin
      Result := GetState(STATE_VAL_PRESS);
      if Result = nil then
        Result := GetState(STATE_VAL_FOCUS);
      if Result = nil then
        Result := GetState(STATE_VAL_IDLE);
    end
    else if State = csDisabled then
    begin
      Result := GetState(STATE_VAL_DISABLE);
      if Result = nil then
        Result := GetState(STATE_VAL_IDLE);
    end;
  end;
end;

function TAHMUIStateObjectList.Modify: Boolean;
begin
{$IFDEF DESIGNER}
  Result := TfrmObjectStateList.ShowList(Self);
  if Result and Assigned(FOwner) then FOwner.DoModified;
{$ELSE}
  Result := False;
{$ENDIF}
end;

procedure TAHMUIStateObjectList.ListStates(Lines: TStrings);
var
  i: Integer;
begin
  if not Assigned(Lines) then Exit;

  // Build list of states for appropriate type
  case FStateType of
    stCheckableControl:
    begin
      Lines.Add(STATE_VAL_IDLE);
      Lines.Add(STATE_VAL_FOCUS);
      Lines.Add(STATE_VAL_PRESS);
      Lines.Add(STATE_VAL_DISABLE);
      Lines.Add(STATE_VAL_IDLE_CHECK);
      Lines.Add(STATE_VAL_FOCUS_CHECK);
      Lines.Add(STATE_VAL_PRESS_CHECK);
      Lines.Add(STATE_VAL_DISABLE_CHECK);
    end;
    stControl:
    begin
      Lines.Add(STATE_VAL_IDLE);
      Lines.Add(STATE_VAL_FOCUS);
      Lines.Add(STATE_VAL_PRESS);
      Lines.Add(STATE_VAL_DISABLE);
    end;
    stMedia:
    begin
      Lines.Add(MEDIA_VAL_PARENT);
      Lines.Add(MEDIA_VAL_FOLDER);
      Lines.Add(MEDIA_VAL_PLAYLIST);
      Lines.Add(MEDIA_VAL_THEME);
      Lines.Add(MEDIA_VAL_PICTURE);
      Lines.Add(MEDIA_VAL_AUDIO);
      Lines.Add(MEDIA_VAL_RADIO);
      Lines.Add(MEDIA_VAL_VIDEO);
      Lines.Add(MEDIA_VAL_DVD);
      Lines.Add(MEDIA_VAL_INFO);
      Lines.Add(MEDIA_VAL_UNKNOWN);
    end;
    stCustom:
      for i := 0 to Pred(TotalCount) do
        Lines.Add(GetState(i));
  end;
end;

//----------------------------------------------------------------------------//

constructor TAHMUIObject.Create(const Name: String);
begin
  inherited Create;

  // Setup custom properties
  FName := Name;
  FXMLTagName := 'Undefined';
end;

procedure TAHMUIObject.SetAncestor(Ancestor: TAHMUIObject);
begin
  // Descendants may do more complex things here
  FAncestor := Ancestor;
end;

function TAHMUIObject.GetIsBaseObject: Boolean;
begin
  // Determine if this object is owned by a base list
  if Assigned(FOwner) then
    Result := (FOwner.BaseList = nil)
  else
    Result := False;
end;

function TAHMUIObject.GetDesignerInfo: String;
begin
  // Default implementation - just return description/comment property
  if FDescription <> '' then Result := FDescription
                        else Result := Trim(FComment);
end;

function TAHMUIObject.GetDesignerPos: String;
begin
  // Descendants must implement this as required
  Result := '';
end;

procedure TAHMUIObject.SetDesignerPos(Position: String);
begin
  // Descendants must implement this as required
end;

function TAHMUIObject.GetDesignerSize: String;
begin
  // Descendants must implement this as required
  Result := '';
end;

procedure TAHMUIObject.SetDesignerSize(Size: String);
begin
  // Descendants must implement this as required
end;

function TAHMUIObject.GetDesignerRot: String;
begin
  // Descendants must implement this as required
  Result := '';
end;

procedure TAHMUIObject.SetDesignerRot(Rotation: String);
begin
  // Descendants must implement this as required
end;

function TAHMUIObject.GetObjectToCompare: TAHMUIObject;
begin
  // Determine appropriate object to compare with when saving as XML
  if Assigned(FAncestor) then
    Result := FAncestor
  else if Assigned(FOwner) then
    Result := FOwner.EmptyObject
  else
    Result := nil;
end;

function TAHMUIObject.TagBegin: String;
begin
  // We'll always need a begin tag and name attribute
  Result := TGB + XmlTagName + SPC + ATTR_NAME + ATB + EncodeXML(FName);

  // Do we have an ancestor assigned?
  if (FAncestor <> nil) then
  begin
    // We need description attribute if it's different from ancestor
    if (FDescription <> '') and (FDescription <> FAncestor.Description) then
      Result := Result + ATN + ATTR_DESC + ATB + EncodeXML(FDescription);
    // Add on ancestor name attribute
    Result := Result + ATN + ATTR_INHERIT + ATB + EncodeXML(FAncestor.Name) + ATC;
  end
  else
  begin
    // We need description attribute if it's not empty
    if (FDescription <> '') then
      Result := Result + ATN + ATTR_DESC + ATB + EncodeXML(FDescription) + ATC
    else
      Result := Result + ATC;
  end;
end;

function TAHMUIObject.TagEnd: String;
begin
  // Construct XML end tag
  Result := TGE + XmlTagName + TGC;
end;

procedure TAHMUIObject.ClearProperties;
begin
  // Clear standard object properties prior to reparsing
  FDescription := '';
  FComment := '';
  FState := osValid;
end;

procedure TAHMUIObject.DoModified;
begin
  // Set modified flag for object
  FModified := True;

  // Inform application manager of modification
  if Assigned(ApplicationManagerInstance.OnModified) then
    ApplicationManagerInstance.OnModified(Self);
end;

function TAHMUIObject.DesignerAdjustPos(DX, DY: Integer): Boolean;
begin
  // Descendants must implement this as required
  Result := False;
end;

function TAHMUIObject.DesignerAdjustSize(DX, DY: Integer): Boolean;
begin
  // Descendants must implement this as required
  Result := False;
end;

function TAHMUIObject.DesignerAdjustRot(DX, DY, DZ: Single): Boolean;
begin
  // Descendants must implement this as required
  Result := False;
end;

function TAHMUIObject.PreviewKeyPress(KeyCode: Word; Shift: TShiftState): Boolean;
begin
  // Descendants must implement this to support previewing
  Result := False;
end;

function TAHMUIObject.PreviewMouseDown(X, Y: Single): Boolean;
begin
  // Descendants must implement this to support previewing
  Result := False;
end;

function TAHMUIObject.PreviewMouseMove(X, Y: Single; Down: Boolean): Boolean;
begin
  // Descendants must implement this to support previewing
  Result := False;
end;

function TAHMUIObject.PreviewMouseUp(X, Y: Single): Boolean;
begin
  // Descendants must implement this to support previewing
  Result := False;
end;

function TAHMUIObject.PreviewMouseWheel(Delta: Integer): Boolean;
begin
  // Descendants must implement this to support previewing
  Result := False;
end;

function TAHMUIObject.RenderPreview: Boolean;
begin
  // Descendants must implement this to support previewing
  Result := False;
end;

function TAHMUIObject.IsAncestorOf(Descendant: TAHMUIObject): Boolean;
begin
  // Set default result - not descended
  Result := False;

  // Check if we are ancestor of passed descendant
  while Descendant <> nil do
    if Self = Descendant.Ancestor then
    begin
      Result := True;
      Break;
    end
    else
      Descendant := Descendant.Ancestor;
end;

function TAHMUIObject.IsEligibleAncestor(Child: TAHMUIObject): Boolean;
begin
  // Determine whether we could be a potentially viable ancestor for child...
  // We check for ancestors linking back to child object, and for base objects
  // linking to non-base ancestors which would fail when descriptor unloads
  if Assigned(Child) and (Child <> Self) then
    if Assigned(Self.Ancestor) then
      Result := Self.Ancestor.IsEligibleAncestor(Child)
    else
      Result := not Child.IsBaseObject or Self.IsBaseObject
  else
    Result := False;
end;

function TAHMUIObject.ModifyActions: Integer;
begin
  // Descendants will specify number of supported actions
  Result := 0;
end;

function TAHMUIObject.Modify(Action: Integer): Boolean;
begin
  // Descendants will implement this method
  Result := False;
end;

function TAHMUIObject.ModifyValue(var Value: String; const Parameter: String): Boolean;
begin
  // Descendants will implement this method
  Result := False;
end;

function TAHMUIObject.ModifyCaption(Action: Integer): String;
begin
  // Descendants will implement this method
  Result := '';
end;

procedure TAHMUIObject.SeedObject;
begin
  // Descendants will implement this method
end;

procedure TAHMUIObject.Assign(Source: TPersistent);
begin
  // Copy properties from source object to self
  Description := TAHMUIObject(Source).Description;
  Comment := TAHMUIObject(Source).Comment;
  Ancestor := TAHMUIObject(Source).Ancestor;
end;

procedure TAHMUIObject.AssignContents(Source: TAHMUIObject);
begin
  // Default implementation just uses standard Assign method above
  Assign(Source);
end;

procedure TAHMUIObject.SaveAsXML(Lines: TStrings);
begin
  // Top and tail XML, but allow SaveXMLBody method to do the work
  SaveXMLComments(Lines);
  Lines.Add(TABS[FXMLIndent + 2] + TagBegin);
  SaveXMLBody(Lines);
  Lines.Add(TABS[FXMLIndent + 2] + TagEnd);
end;

procedure TAHMUIObject.SaveXMLComments(Lines: TStrings);
begin
  // Only save comments when populated and different from ancestor comments
  if (FComment <> '') and ((FAncestor = nil) or (FAncestor.Comment <> Comment)) then
    FormatXMLComment(Comment, FXMLIndent + 2, Lines);
end;

procedure TAHMUIObject.SaveXMLBody(Lines: TStrings);
begin
  // Descendants will implement this method
end;

function TAHMUIObject.XMLReference(TagName: String = ''): String;
begin
  if TagName = '' then
    Result := TGB + XmlTagName + SPC + ATTR_NAME + ATB + EncodeXML(FName) + ATE
  else
    Result := TGB + TagName + SPC + ATTR_NAME + ATB + EncodeXML(FName) + ATE
end;

procedure TAHMUIObject.ParseCommonXML(XML: TAHMXMLHelper);
begin
  // Descendants may override this method to share common XML parsing
end;

procedure TAHMUIObject.ParseFromXML(XML: TAHMXMLHelper);
begin
  // Descendants will implement this method
end;

procedure TAHMUIObject.ReparseFromXML(XML: TAHMXMLHelper);
begin
  // Clear custom properties before reparsing
  ClearProperties;

  // Now use standard method to assign/parse properties
  FOwner.ParseObjectFromXML(Self, XML);
end;

procedure TAHMUIObject.Revert;
var
  SavedAncestor: TAHMUIObject;
begin
  // Keep a note of ancestor
  SavedAncestor := FAncestor;

  // Clear properties and reassign from ancestor
  ClearProperties;
  Assign(FAncestor);

  // Fix inheritance
  FAncestor := SavedAncestor;
end;

procedure TAHMUIObject.Rename(Name: String);
begin
  // Descendants may override this to customise behaviour
  FName := Name;
end;

procedure TAHMUIObject.Remove;
begin
  // Descendants may override this to customise behaviour
  FOwner.RemoveObject(Self);
end;

procedure TAHMUIObject.InvalidateUIObject(UIObject: TAHMUIObject);
begin
  // Descendants may override this to respond to dependent object changes
end;

procedure TAHMUIObject.DeleteUIObject(UIObject: TAHMUIObject);
begin
  // Descendants may override this to respond to dependent object changes
end;

procedure TAHMUIObject.BuildProperties(Properties: TAHMUIPropertyList);
begin
{$IFDEF DESIGNER}
  // Build standard object properties
  Properties.Add('Name',         'Name',        CAT_IDENTITY, HINT_NAME);
  Properties.Add('Description',  'Description', CAT_IDENTITY, HINT_DESCRIPTION);
  Properties.Add('Comment',      'Comment',     CAT_IDENTITY, HINT_COMMENT);
  Properties.Add('Inherit From', 'Ancestor',    CAT_IDENTITY, HINT_ANCESTOR);
{$ENDIF}
end;

class function TAHMUIObject.ClassName: ShortString;
var
  Name: ShortString;
  i: Integer;
begin
  Name := inherited ClassName;

  // Remove TAHM prefix from name
  if Copy(Name, 1, 4) = 'TAHM' then
    Name := Copy(Name, 5, Length(Name));

  // Insert spaces before camel cased words
  Result := Copy(Name, 1, 1);
  for i := 2 to Length(Name) do
    if Name[i] in ['A'..'Z'] then Result := Result + ' ' + Name[i]
                             else Result := Result + Name[i];
end;

//----------------------------------------------------------------------------//

constructor TAHMUIDisplayObject.Create(const Name: String);
begin
  inherited;

  // Set default properties for rendering preview
  FPreviewClass := TAHMControl;
  FPreviewText := Name;
  FEditable := True;
end;

procedure TAHMUIDisplayObject.ClearProperties;
begin
  inherited;

  // Clear custom display object properties
  VirtualWidth := 0;
  VirtualHeight := 0;
end;

function TAHMUIDisplayObject.GetDesignerSize: String;
begin
  // Return current width/height in concatenated string format
  Result := Format('%d,%d', [FVirtWidth, FVirtHeight])
end;

procedure TAHMUIDisplayObject.SetDesignerSize(Size: String);
var
  W, H: Integer;
begin
  if ParseStringValues(Size, W, H) then
  begin
    VirtualWidth := W;
    VirtualHeight := H;
  end;
end;

procedure TAHMUIDisplayObject.SetVirtualWidth(Width: Integer);
begin
  FVirtWidth := Width;
  FWidth := ScreenInstance.ScaleVirtualX(Width);
  ApplicationManagerInstance.UIManager.InvalidateUIObject(Self);
end;

procedure TAHMUIDisplayObject.SetVirtualHeight(Height: Integer);
begin
  FVirtHeight := Height;
  FHeight := ScreenInstance.ScaleVirtualY(Height);
  ApplicationManagerInstance.UIManager.InvalidateUIObject(Self);
end;

function TAHMUIDisplayObject.DesignerAdjustSize(DX, DY: Integer): Boolean;
var
  NewWidth, NewHeight: Integer;
begin
  // Update size in response to designer adjustment - clamp negative values
  NewWidth := Max(0, VirtualWidth + DX);
  NewHeight := Max(0, VirtualHeight + DY);
  if DX <> 0 then VirtualWidth := NewWidth;
  if DY <> 0 then VirtualHeight := NewHeight;
  if (DX <> 0) or (DY <> 0) then Modified := True;

  Result := False;
end;

function TAHMUIDisplayObject.RenderPreview: Boolean;
{$IFDEF DESIGNER}
var
  Control: TAHMControl;
{$ENDIF}
begin
{$IFDEF DESIGNER}
  // Default preview rendering implementation
  with ScreenInstance, ScreenInstance.Viewport do
  begin
    Canvas.DesignerBackground(ViewportRect);
    with ApplicationManagerInstance.UIManager do
      Control := GetPreviewControl(TAHMControlClass(FPreviewClass));

    if FFullscreen then
    begin
      Control.Width := Width;
      Control.Height := Height;
    end;
    Control.Style := Self;
    Control.DisplayText := FPreviewText;
    ConfigurePreview(Control);
    Control.Render(Viewport);
  end;
{$ENDIF}
  Result := True;
end;

function TAHMUIDisplayObject.PreviewRect: TAHMRectF;
begin
  // Return preview rendering dimension
  if FFullscreen then Result := ScreenInstance.ScreenRect
                 else Result := MakeRectF(0, 0, FWidth, FHeight);
end;

procedure TAHMUIDisplayObject.ConfigurePreview(Control: TObject);
begin
  // Descendants may implement this to customise the preview control
end;

procedure TAHMUIDisplayObject.PreRender(Control: TObject);
var
  oControl: TAHMAbstractControl;
begin
  // Get details of passed control
  oControl := Control as TAHMAbstractControl;

  // Delegate to method below
  PreRender(oControl, oControl.XPos, oControl.YPos, oControl.Width, oControl.Height);
end;

procedure TAHMUIDisplayObject.PreRender(Control: TObject; iX, iY, iWidth, iHeight: Single);
begin
  // Descendants will override this method to do something more useful!
end;

procedure TAHMUIDisplayObject.Render(Control: TObject);
var
  oControl: TAHMAbstractControl;
begin
  // Get details of passed control
  oControl := Control as TAHMAbstractControl;

  // Delegate to method below
  Render(oControl, oControl.XPos, oControl.YPos, oControl.Width, oControl.Height);
end;

procedure TAHMUIDisplayObject.Render(Control: TObject; iX, iY, iWidth, iHeight: Single);
var
  oControl: TAHMAbstractControl;
begin
  // Get details of passed control & its viewport
  oControl := Control as TAHMAbstractControl;

  // Pre-render the control if doesn't have a valid render cache
  if not (oControl.Valid and oControl.RenderCache.Valid) then
  begin
    PreRender(Control, iX, iY, iWidth, iHeight);
    oControl.Valid := True;
  end;

  // Descendants will override this method to do something more useful!
end;

procedure TAHMUIDisplayObject.Render(Control: TObject; iX, iY, iWidth, iHeight: Single; Clip: Boolean);
var
  oControl: TAHMAbstractControl;
begin
  // Get details of passed control & its viewport
  oControl := Control as TAHMAbstractControl;

  // Pre-render the control if doesn't have a valid render cache
  if not (oControl.Valid and oControl.RenderCache.Valid) then
  begin
    PreRender(Control, iX, iY, iWidth, iHeight);
    oControl.Valid := True;
  end;

  // Descendants will override this method to do something more useful!
end;

procedure TAHMUIDisplayObject.Assign(Source: TPersistent);
begin
  inherited Assign(Source);

  // Copy size properties from source object to self
  with Source as TAHMUIDisplayObject do
  begin
    Self.VirtualWidth := VirtualWidth;
    Self.VirtualHeight := VirtualHeight;
  end;
end;


end.
